perm filename M.OLD[PAG,LCS] blob sn#598963 filedate 1981-07-12 generic text, type T, neo UTF8
00100		SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8,P9,P10,P11,P12)
00200		COMMON/XRN/RN(1) /PTR/KWDS(1) /SF/KL,RT,KP
00300		KWDS(KP)=KL
00400		KP=KP+1
00500		RN(KL)=P0
00600		RN(KL+1)=P1
00700		RN(KL+2)=RT
00800		RN(KL+3)=P3
00900		RN(KL+4)=P4
01000		RN(KL+5)=P5
01100		IF(P0.LT.4.)GO TO 1
01200		RN(KL+6)=P6
01300		RN(KL+7)=P7
01400		RN(KL+8)=P8
01500		RN(KL+9)=P9
01600		RN(KL+10)=P10
01700		RN(KL+11)=P11
01800		RN(KL+12)=P12
01900	1	KL=KL+3+P0
02000		END
02100	
02200		FUNCTION RIGHT(NA,J,JK)
02300		COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
02400		K=NA+J
02500		N6=NJ
02600		IF(K.GT.0)GO TO 4
02700		RIGHT=Q(4)
02800		RETURN
02900	4	RX=Q(JK+3)
03000		R=Q(JK+2)
03100		JX=1
03200		IF(J.GT.0)JX=I  
03300	C FORWARD LOOP
03400	1	R8=CODEN(KPN,K,Q,LA)
03500		IF(R8.EQ.4)GO TO 2
03600	 	IF(Q(LA+2).NE.R)GO TO 3
03700		IF(R8.EQ.18..OR.R8.EQ.17.)GO TO 2
03800	C JUMP ON KEY SIG OR METER
03900	3	IF(K.EQ.JX)GO TO 5
04000		K=K+J
04100		GO TO 1
04200	5	IF(J.LE.0)RIGHT=RX
04300		RETURN  
04400	C SKIP NEXT IF GOING FORWARD IN LOOP (LOOKING TO RIGHT)
04500	C USE ITS OWN POS.-2 IF NOTHING FOUND TO LEFT
04600	C C NOW FOUND ITEM TO LEFT OR RT ON THIS STAFF.
04700	2	RIGHT=Q(LA+3)
04800		END
04900	
05000		SUBROUTINE RESTS
05100		COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL
05200		XLFT=0
05300		SIG=-99
05400		REST=0
05500		K=1
05600	50	JL=KPN(K)
05700		R=Q(JL+1)
05800		IF(XLFT.NE.0)GO TO 5
05900		IF(R.LE.4)XLFT=Q(JL+3)
06000		GO TO 3 
06100	5	IF(R.NE.17)GO TO 3
06200		IF(Q(JL+5).EQ.SIG)GO TO 60
06300		SIG=Q(JL+5)
06400	3	IF(R.NE.2)GO TO 231
06500		IF(Q(JL).GE.6)GO TO 7
06600		GO TO 231 
06700	7	IF(Q(JL+8).LE.-4)GO TO 231
06800		IF(Q(JL+7).LE.0)GO TO 231
06900	C (IGNORE NON-RHYTH.)
07000	C CATCH BAR REPEAT SIGN
07100		IF(Q(JL+8).EQ.0)GO TO 231
07200	C (WHOLE REST OVER CUE NOTES)
07300		IF(REST.NE.0)GO TO 6
07400		JR=JL+6
07500	C  POINTER TO REST NUM.
07600		R=Q(JR+1)
07700		IF(R.LT.5)R=5
07800		Q(JR+1)=R*.6
07900	C  REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
08000	6	REST=REST+1.
08100		Q(JR+2)=REST
08200		Q(JR-2)=-2.
08300	C (LOWER THE REST'S POS.)
08400		JL=K+2
08500		IF(JL.GE.LLL)RETURN
08600		LB=KPN(JL)
08700		IF(Q(LB+1).NE.2)GO TO 233
08800	C NEXT IS TO COMBINE MEASURES OF REST
08900		IF(Q(LB).LT.6)GO TO 233
09000	C  SKIP NON-WHOLE RESTS
09100		N=KPN(JL-1)
09200		IF(Q(N+1).NE.4.)GO TO 233
09300	C  IS REST FOLLOWED BY A BAR?	OR RHRSL NUM?(COULD BE A PROB. HERE!!!)
09400	C SO IT WON'T BE FOUND NEXT TIME AROUND.
09500		Q(LB+1)=-1.
09600	C   CHANGE CODE #
09700		Q(N+1)=-1.
09800		K=JL
09900		GO TO 6
10000	60	Q(JL+1)=-1.
10100		GO TO 231
10200	233	REST=0
10300	231	K=K+1
10400		IF(K.LT.LLL)GO TO 50
10500		END
10600	
10700		SUBROUTINE EXCHG(M,N)
10800		DIMENSION M(2),N(2)
10900		J=M(1)
11000		M(1)=M(2)
11100		M(2)=J
11200		J=N(1)
11300		N(1)=N(2)
11400		N(2)=J
11500		END
11600	
11700		SUBROUTINE EXCH(J,K)
11800		L=J
11900		J=K
12000		K=L
12100		END	
12200	
12300		SUBROUTINE INMUS(NAME,EXT,RN,KWDS,JSTFAC)
12400		DIMENSION RN(1),KWDS(1),JSTFAC(1)
12500		CALL GETEXT(NAME,EXT)
12600		CALL EXTIN(JSTFAC,20)
12700	C READ ONLY 20 WDS IN PAGE ONLY****** NOT [=128]  
12800		JJ=JSTFAC(19)
12900	C JSTFAC(19) = THE WD CNT.
13000	C ********** CHANGE JSTFAC ARRAY FOR PDP11 ***************
13100		CALL EXTIN(RN,JJ)
13200	C	MOVE @15	;@R		;IF(R(1).NE.INTEGER 1)GO TO I3
13300	C	CAIE 1		;OLD FORMAT ?    ***** ASSUMES NEW FORMAT (NO KWDS ARRAY)
13400	C	JRST I3		;NO
13500	C	USETI 12,2	;YES, READ 2ND RECORD AGAIN   (12 =CH)
13600	C	JSA 16,EXTIN  	;CALL EXTIN(RS,128)
13700	C	JUMP @12	;JUMP @KW
13800	C	JUMP =17(11)	;JUMP NWDS    	;CALL EXTIN(K,J)
13900	C	JRST I1		;GO BACK AND GET R ARRAY
14000	3	N=1 
14100		L=1
14200		KWDS(1)=1
14300	4	N=N+RN(N)+3
14400	C   HERE'S THE LOOP 
14500	C GET WD CNT -2
14600		L=L+1
14700	C  UPDATE THE COUNTER OF THE POINTER LIST
14800		KWDS(L)=N
14900		IF(N.LT.JJ)GO TO 4
15000		END
15100	
15200		FUNCTION RCURVE(R)
15300		DIMENSION R(1)
15400	C R(1) IS R3   R(4) IS R6, ETC.
15500		X=R(4)-R(1)
15600		RCURVE=R(6)+1.
15700		IF(RCURVE.LT.0)X=X+RCURVE+RCURVE
15800		X=X/25.
15900	C R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
16000		RCURVE=X+2.+ABS(R(3)-R(2))/10.
16100		IF(R(5).LT.0)RCURVE=-RCURVE
16200	C IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
16300		END
16400	
16500		SUBROUTINE SHRNK(K,IT)
16600		COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
16700		COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
16800		L10=IT-1
16900		L11=KPN(IT+1)
16950	C END OF Q DATA
17000	C	X=Q(L+3)
17100		K2=K
17200		K12=K2
17300		K3=KPN(K2)
17400		K6=K3
17500	C	A13=Q(K3+3)
17550	 	R8=Q(K3+3)
17600	C POS. OF CLEF TO BE MOVED.
17700		K4=KPN(K2+1)
17750	C PTR TO NEXT ITEM
17800		K1=K4
17900		K3=K3-K4
17950	C WDCNT OF DELETE ITEM
18000		K4=K4-KPN(K2+2)
18050	C NEXT +1
18100		K3=K3-K4
18150	C AMOUNT OF CHANGE
18200	C1	K5=KPN(K2+2)
18300	C	K5=K5-KPN(K2+1)
18400	C	K5=K5+KPN(K2)
18500	C	KPN(K2+1)=K5
18550	1	KPN(K2+1)=KPN(K2+2)-KPN(K2+1)+KPN(K2)
18600	
18700		IF(K2.EQ.L10)GO TO 4
18800		K2=K2+1
18900		GO TO 1
19000	4	K2=KPN(K2+1)
19050	C LAST PTR
19100	C	A7=Q(K6+3)
19150		R4=Q(K6+3)
19200	C POS FOR LATER "MOVE"
19400	2	Q(K6)=Q(K1)
19500		K1=K1+1
19600		IF(K1.EQ.L11)GO TO 5
19700		K6=K6+1
19800		GO TO 2
19900	5	IT=L10
20000		I=L10
20100	C I=LEND (FOR FINAL ENDPOINT)
20200	C	R4=A7
20250	C	R8=A13
20260	C R8=EXPAND REMAINDER OF LINE TO CLEF POS.
20400	6	LL=0
20500	C LL=0 (NO JUSTIFY)
20600		R5=200.
20700		R2=0
20800		R9=R5
20900		R7=0
21200		CALL PTMOVE(Q,KPN(K12))
21300		END
21400	
21500	C	SUBROUTINE EXPND(J)
21600	CC TO SHIFT LINE TO RT. WHEN ADDING KSIG.
21700	C	COMMON/STF/RSTFAC(8),RSTJ2 
21710	C	COMMON R2,JA,REST,J2,R3,R4,R5,R6,R7,R8,R9
21720	C	COMMON /PX/KPN(1) /Q/Q(1) /LLL/LLL,LL,I
21800	CC??	A5=5.
21900	C	R4=7.1*RSTJ2
22000	C	K12=J+2
22100	CC GET PTR TO KPN   ADD 2 (FOR NOW, ANYWAY)
22200	C	R8=0
22400	CC  GO MOVE IT
23000	C6	LL=0
23100	CC LL=0 (NO JUSTIFY)
23200	C	R5=200.
23300	C	R2=0
23400	C	R9=R5
23500	C	R7=0
23800	C	CALL PTMOVE(Q,KPN(K12))
23900	C	END